C*****  SUBRS NOTES, BMX, ACSHFT  ***********

	SUBROUTINE NOTES
	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	COMMON/SCX/RHY(4),JALPHA(24),JX,RA,JZ,IRHY,RB,KA,KB,IZ
	COMMON /XRN/RN(4000) /DPY/ST(4000),WDS(250),MEDIT,GO	
	COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
	1,DBST,NFLG,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
     1 /ALF/CLF,JQX,D,KQ,JG,X,ACC,T,Y,LL,RZ,RC,INP(61) /POS/POS1,POS2
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
	DIMENSION R(10,80)
	EQUIVALENCE (R,RN(3001)),(STEM,RN(2999)),(STUP,RN(3921))
	DATA ACMV/2.3/
	POS1=0
	POS2=200
444	FORMAT(' TYPE POS1, POS2, (SPC)  '$)
	CALL SETUP
	IF(STUP.GE.0)GO TO 8
CC	IF(ST(3601).GE.0)GO TO 8
C   ST(3601) IS LOC. OF RPOS(1,1)
C SKIPS IF USING SETUP ON STAFF 4
4333	TYPE 444
	ACCEPT F78F,POS1,POS2,RA
C  TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
	STUP=STUP-RA
C  DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
	IF(POS2.EQ.0)POS2=200.
	IF(POS1.GE.POS2)GO TO 4333
8	KN=0
	IRHY=0
C  IZ=# OF ITEMS FROM SCANR*******
	IZ=I-1
CC	IF(IZ.GT.50)IZ=50
C  LIMIT OF 50 ITEMS***** IS NOW SET TO 100 4/74 *****
	CLF=1
	JQX=0
	D=(POS2-POS1)/I
C   D WILL SPACE ALL ITEMS EVENLY FOR NOW

	STEM=-1
C   K=COUNTER FOR USEFUL ITEMS (OMITS CLEFS)
	K=1
	KQ=1
C   LOOPS TO 7333 
7	JG=0
	X=V(KQ)
	ACC=0
	RA=2.
	DO 89 LL=4,10
89	R(LL,K)=0
C   TO CLEAR END OF ITEM
	IF(X.LT.0)GO TO 86
C  JUMP IF A CLEF OR BAR OR METER
	IRHY=IRHY+1
C   ADDS A RHYTHMIC UNIT
	GO TO 2333
C  TO CLEAR LAST PARAMS IN SOME ITEMS LATER
86	IF(IFIX(AMOD(X,100.0)).EQ.-99)GO TO 84
C   JUMP IF A CLEF 
	IF(X.GE.-599)GO TO 77
	IF(X.GT.-610)GO TO 84
C  FOUND AN EXTENDED BARLINE?
77	IF(X.LT.-1.)GO TO 2333
C  JUMP IF IT'S A DBLSTP
	RA=18.
	L=-X*100.
	Y=L
	R(6,K)=-(X+Y/100.)*10000.+.0001
C   GETS BOTTOM NUM OF METER
	X=85.
842	R(5,K)=Y
	GO TO 843
84	T=CLF
	CLF=-(99.+X)/100.
	IF(AMOD(CLF,1.).EQ.0)GO TO 841
	IF(CLF.GT.5.0)GO TO 841
C  IS THE CLEF INVISIBLE?
	CLF=IFIX(CLF)
	GO TO 871
841	RZ=X
	X=85.
C   WILL SKIP LATER
	Y=CLF
	LL=Y
	RA=3.
CC	IF(LL.LT.5)GO TO 83
C   CLF5 = BAR LINE
	IF(LL-5)851,41,40
CC	IF(LL.EQ.5)GO TO 41
40	IF(LL.GT.7)GO TO 83
	STEM=(CLF-5)*10.
	CLF=T
C CONTROLS STEM DIREC. UNTIL CHNGD. SU(LL=6) OR SD(LL=7)
	GO TO 871
CC41	IF(LL.NE.5)GO TO 83
41	RA=4.
	Y=1.
	IF(LL.NE.CLF)Y=-599.-RZ
C 'M'=1 STF.  'M2'=2 STAVES, ETC.
831	CLF=T
	GO TO 85
CC83	IF(Y.LT.10.)GO TO 851
C  NOW A KSIG.
83	RA=17.
	Y=Y/10.
	IF(Y.GT.10.)Y=10.-Y
C  CHANGES FLAT TO NEG.
	R(6,K)=T-1
	CLF=T
CC	GO TO 831
	GO TO 842
851	Y=Y-1
C  ↑↑↑↑ FOR NEW CLEFS ROUTINE  6/74
	IF(JQX.NE.0)Y=Y+100.
	JQX=-1
C   AFTER THE FIRST TIME, THEN MINICLEFS
	R(5,K)=Y
843	Y=0
C  FOR NEW CLEF ROUTINE
85	R(4,K)=Y
2333	R(2,K)=STAFF
	IF(X.GT.0)KN=KN+1
	R(3,K)=KN*D+POS1
	IF(X.NE.86)GO TO 852
	R(8,K)=9999.
	GO TO 7333
C FOR INVIS. RESTS - CHECKED IN SUBR. NEWR
852	IF(X.LT.85.)GO TO 1852
	IF(X.LT.1000.)GO TO 7333
C  JUMP IF REST, METER, CLEF OR BAR
1852	RA=1.
	IF(X.GT.0)GO TO 2133
	X=-X
	JG=-1
C  DBLSTOP=-1
	R(8,K)=-1.
2133	IF(X.LT.1000.)GO TO 433
	IF(X.LT.10000.)GO TO 233
	IF(X.LT.100000.)GO TO 333
	ACC=3.
C  NATURAL
	X=X-100000.
	GO TO 433
333	ACC=2.
C  SHARP
	X=X-10000.
	GO TO 433
233	ACC=1.
C  FLAT
	X=X-1000.
433	Y=AMOD(X,12.0)
	IF(Y.EQ.0)Y=12.
	J=(Y+1)/2
	IF(Y.GT.5.)J=(Y+2)/2
	IF(ACC.EQ.0)GO TO 133
	IF(ACC.EQ.3.)GO TO 133
	IF(ACC.EQ.1.)GO TO 533
	IF(Y.EQ.1)GO TO 177
	IF(Y.NE.6.)GO TO 133
177	J=J-1
	GO TO 133
533	J=J+1
133	IF(CLF.EQ.2)GO TO 633
	IF(CLF.EQ.3)GO TO 733
	IF(CLF.EQ.4)GO TO 833
	KA=4
	KB=0
	GO TO 933
633	KA=2
	KB=-2
	GO TO 933
733	KA=3
	KB=-1
	GO TO 933
833	KA=2
	KB=-6
933	L=(X-1)/12+1
C   L IS OCTAVE
	N=(L-KA)*7+J+KB
	T=10.
	IF(N.GE.7)T=20.
	IF(STEM.GT.0)T=STEM
C  FOR STEM DIRECTIONS - 'B' AND HIGHER HAVE STEMS DOWN.
	R(4,K)=N
C  N=NOTE #
	IF(JG.EQ.0)GO TO 3133
C  JUMP IF NOT DBLSTOP
	IF(R(5,K-1).GE.10.)MX=K-1
C  MX=1ST NOTE OF CHRD
	T=0
	L=K-MX
	IF(N.LT.R(4,MX))L=-L
	R(7,MX)=L
C L+=STEM UP, L-=STEM DOWN ... USED AT END OF NOTES.
	RZ=ABS(R(4,MX)-FLOAT(N))-1.
C  EXTENDS THE STEM!
	IF(RZ.LT.1.)RZ=1.
	R(8,MX)=RZ
3133	R(5,K)=ACC+T

7333	R(1,K)=RA
	IF(X.LT.87)GO TO 87
	RX=-1
	IF(X.GT.87)RX=X-87
C TYPE /RW/ FOR WHOLE REST PRINTOUT, /Rn/ FOR ADDED NUMB.
	R(8,K)=RX
	R(9,K)=-1
87	K=K+1
871	KQ=KQ+1
	IF(KQ.LE.IZ)GO TO 7

	IZ=K-1
C  IZ IS NOW REALLY THE NUMBER OF ITEMS TO BE PROCESSED
C  NEXT ADJUSTS PLACEMENT OF ACCIDENTALS AND 2NDS.
	K=1
1	RX=R(7,K)
	IF(RX.EQ.0)GO TO 2
	IF(R(1,K).EQ.2.)GO TO 2
C  JUMP IF NO CHRD COMING
	IF(RX.GT.0)GO TO 3
C  JUMP IF STEM IS UP
	RA=R(5,K)
	IF(RA.LT.10)GO TO 277
	IF(RA.LT.20.)R(5,K)=RA+10.
C  PUTS STEM DOWN IF IT WASN'T
277	L=K-RX
C  RX=TOTAL(-1) NOTES IN CHORD
	R(7,K)=0
4	RA=R(4,K)
	RC=0
C  INTERVAL TO PREVIOUS NOTE
C  CHECK ON USE OF N ELSEWHERE
	N=K+1
	IF(K.LT.L)RC=RA-R(4,N)
C  INTERVAL TO NEXT NOTE
	IF(RC+R(6,K).EQ.1.)R(6,N)=20
C  PUSHES NOTE TO LEFT 
5	K=N
	IF(K.GT.L)GO TO 220
	GO TO 4

3	DO 30 M=2,IZ
	L=M-1
	IF(R(4,M)-R(4,L)+R(6,L).NE.1.)GO TO 30
	IF(R(3,M).NE.R(3,L))GO TO 30
	R(6,M)=10
	R(6,L)=30
30	CONTINUE
C  TO HELP DOTTED NOTES.
C  MOVES NOTE TO RIGHT OF STEM WHEN 2ND.
C  THE STEM IS UP
	RA=R(5,K)
	IF(RA.GE.20.)R(5,K)=RA-10.
C  PUTS STEM UP IF IT WASN'T
	R(7,K)=0
	K=1+K+RX
220	CALL ACSHFT(RX)
C  L=K-1=END OF CHORD;  L-ABS(RX)=START OF CHORD; +RX=↑  -RX=↓
	GO TO 22

2	K=K+1
22	IF(K.LE.IZ)GO TO 1
	R(1,K)=0
	END

	SUBROUTINE BMX(RA)
C  RA=NUMB. OF TAILS
	DIMENSION R(10,80),VQ(100)
C  VQ HOLDS TEMPORARY INFO RE. MULTIPLE BEAMS.
	COMMON E,F,G,H,RJQ(34),RB,VQX,JB,B,JV,JW /XRN/RN(4000)
	EQUIVALENCE (R,RN(3001)),(VQ,RN(3801))
	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	COMMON/SCX/RHY(4),JALPHA(24),JX,U,JZ,IRHY,JD,KA,KB,IZ
	COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /SC/J,L,MK
	1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,IQT
	1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
	M=IS-12
	DO 1 L=KN,K
1	VQ(L)=AMOD(R(7,L),10.0)
	VQ(K+1)=0
C   CLEARS IT FOR ROUTINE AT '3'
	JB=KN

6	RN(IS+10)=0
	RN(IS+9)=0
	DO 2 L=JB,K
	IF(VQ(L).LE.RA)GO TO 2
C  SKIP IF EQ. TO PRESENT BEAM
	RB=VQ(L)
4	DO 11 JD=L,K
	VQX=VQ(JD)
	IF(VQX.GE.RB)GO TO 20
	IF(VQX.EQ.0)GO TO 11
C  VQX=0 ON NON-STEM NOTES OF CHORDS. (HENCE NO TAILS)
21	B=10.
	IF(L.GT.KN)GO TO 13
	GO TO 16
20	JV=JD
	IF(VQX.GT.RB)GO TO 21
11	JW=JD
	B=20
C  FINDS NEED FOR BEAM TO LEFT 
16	B=B+RA
	DO 5 JE=1,6
5	RN(JE+IS)=RN(JE+M)
	RN(7+IS)=RN(7+M)+RB-RA*2.
C  ADDS RIGHT NUM. OF BEAMS
	IF(L.NE.JV)GO TO 10
	IF(L.EQ.KN)GO TO 377
	IF(L.NE.K)GO TO 10
377	B=-B
C PARTIAL, UNATTACHED BEAM IS PLACED AUTOMATICALLY IN ITMSUB.
	GO TO 8
13	IF(JV.GT.L)GO TO 14
	IF(R(7,L+1).LT.10)GO TO 15
C NEXT FOR DOT ON FOLLOWING NOTE.
	RN(10+IS)=10.
	GO TO 19
15	RN(10+IS)=20.
C SHORT INNER BEAM TO LEFT OF STEM
19	B=-RA
	GO TO 16
14	RN(10+IS)=30
C  LONG INNER BEAM
	JV=-JV
	GO TO 16

C  PARTIAL BEAM IS ON RIGHT(+) OR LEFT(-).  RBM IS LENGTH.
10	IF(L.EQ.KN)GO TO 22
	IF(JV.GE.0)GO TO 17
	B=R(3,L)
	JV=-JV
	L=JV
22	IF(VQ(JW+1).GT.VQ(JW))GO TO 17
	VQ(JW)=VQ(JW+1)
	JW=JW-1
17	IF(L.NE.JB)GO TO 18
	IF(B.LT.20.)L=JV
C PUTS BEAMS IN RIGHT PLACE.
18	RN(9+IS)=R(3,L)
C  THIS WILL BE POS.3
	RN(10+IS)=RA+RN(10+IS)
C  DISPLACES
	GO TO 8
2	CONTINUE
	RETURN
8	JB=JW+1
	RN(8+IS)=B
C  FINDS SIDE (L,R) FOR PARTIAL BEAM
C  FOR NEW DISPLACEMENT
	RN(IS+11)=-1
	CALL UPDATE(9)
C  ADDED ANOTHER ITEM (PART. BEAM)
	IF(JB.LE.K)GO TO 6
	END

	SUBROUTINE ACSHFT(RX)
	COMMON /XRN/RN(4000)
	COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
	1,DBST,NFLG,IXX,ISEMI,IQT,F(50),IAMP,K,KN,M,MODE,IBLA
	DIMENSION R(10,80)
	EQUIVALENCE (R,RN(3001)),(A,F(1)),(B,F(2)),(X,F(4)),
	1(Y,F(5)),(Z,F(6)),(JD,F(7)),(RN1,F(8)),(RH,F(9))
	Z=0
	L=K-1
	M=L-ABS(RX)
	JD=1
	RN1=99
	Y=-.23
	IF(RX.LT.0)GO TO 1
	L=M
	M=K-1
	JD=-1
1	DO 2 N=M,L,JD
C  DOES IT HAVE AN ACCID?
	IF(AMOD(R(5,N),10.).EQ.0)GO TO 2
	A=R(6,N+1)
	B=R(6,N-1)
	IF(RN1.NE.99)GO TO 3
C  IS THIS THE FIRST ACCID?
	RN1=R(4,N)
	GO TO 6
3	RH=R(4,N)
	IF(ABS(RH-RN1).LT.5)GO TO 4
	RN1=RH
	IF(Y.GT.0)Z=Z+.04
C STOPS OCT., ETC. ACCIS BEING MOVED TO LEFT.
	Y=-.23+Z
6	IF(A.EQ.20)GO TO 477
	IF(B.NE.20)GO TO 4
477	Y=Z
4	X=0
	IF(R(6,N).EQ.20)X=-.24
	IF(R(6,N).EQ.10)X=.24
	Y=Y+.23
	IF(X+Y.LT.1)GO TO 7
	RN1=RH
	Z=Z+.04
	Y=0
	IF(A.EQ.20)GO TO 677
	IF(B.NE.20)GO TO 577
677	Y=.23
C  SO Y DOESN'T GET >1.
577	Y=Y+Z
7	X=X+Y
	IF(ABS(X-.04).LT..01)X=0
	IF(X.GE.0)GO TO 5
	Y=.23+Z
	X=Z
5	R(5,N)=R(5,N)+X
2	CONTINUE
	END